ASP WSC Windows Scripting Component

Hot Objects

New

Free

Tell a Friend

Home

Asp File Uploading Component

Copy the codes and paste, and save the code as afu.wsc and run
regsvr32 afu.wsc
to register as component.

Windows Script Component Code Listing

<?xml version="1.0"?>
<component>
<?component error="true" debug="false"?>
<registration
description="ASP File Upload Component"
progid="AFU.WSC"
version="1.00"
classid="{8a848320-7a9b-11d4-9ea4-00a40080d29c}"
>
</registration>
<public>
<comment>
Original code complements of Vadim Maslov found at
http://www.dev-center.com/code/code.asp?CodeID=574.
Conversion to component, encapsulation, cleanup and
addition of saveAs() by Kevin M Pirkl. pirklk@providence.org
</comment>
<property name="Path">
<get/>
<put/>
</property>
<property name="FileCount">
<get/>
</property>
<property name="FieldCount">
<get/>
</property>
<method name="Init">
</method>
<method name="getData">
<PARAMETER name="sHTMLFormField"/>
</method>
<method name="getFileName">
<PARAMETER name="sHTMLFormField"/>
</method>
<method name="getContentType">
<PARAMETER name="sHTMLFormField"/>
</method>
<method name="saveAs">
<PARAMETER name="sHTMLFormField"/>
<PARAMETER name="sNewFile"/>
</method>
</public>
<implements type="ASP"/>
<script language="VBScript">
<![CDATA[
'*************************************************************************
' HOW TO USE THIS THING:
'*************************************************************************
'
' HTML FORM Requirements:
' The form to accept filename data must have "multipart/form-data"
enctype Property !!! Example:
'
' <FORM name="MyForm" enctype="multipart/form-data" action="myaction.asp"
method="post">
' <INPUT type="text" name="txtTest" value="AAAA">
' <INPUT type="file" name="fName">,
' </FORM>
'
' How to use this component:
'
' Set oASPFile = Server.CreateObject( "AFU.WSC")
'
' binaryFileData = oASPFile.getData("fName")
' FileAndPath = oASPFile.getFileName("fName")
' ContentType = oASPFile.getContentType("fName")
' oASPFile.Path = Defaults to current path. This is where files will be written
to.
' oASPFile.saveAs( "fName", "") '- the second param is an
alternative drive:path\filename.ext to write to.
'
'

'*************************************************************************
'Property Variables
'*************************************************************************
const ForReading = 1
const ForWriting = 2
const ForAppending = 3

dim FileCount 'Number of files uploaded
dim FieldCount 'Number of fields uploaded
dim Path 'Path to store files in
dim Dict 'pointer to a Scripting.Dictionary object with form data
Path = Server.mappath(".") & "\"
FileCount = 0
FieldCount = 0
Dict = Null
Init

'*************************************************************************
'Property Methods
'*************************************************************************
function get_Path()
get_Path = Path
end function
function put_Path(newValue)
Path = newValue
end function
function get_FileCount()
get_FileCount = FileCount
end function
function get_FieldCount()
get_FieldCount = FieldCount
end function

'*************************************************************************
'Methods
'*************************************************************************
'-------------------------------------------------------------------------
'Init - Builds a Scripting.Dictionary from uploaded binary data
' Parameters
' pServer [in] - pointer to ASP's Server Object
' pRequest [in] - pointer to ASP's Request Object
'
' Returns a Scripting.Dictionary object which contains all the form data
'-------------------------------------------------------------------------
Function Init()
Dim tBytes
Dim binData
Dim scrDict
tBytes = Request.TotalBytes
RequestBin = Request.BinaryRead(tBytes)
Set scrDict = Server.CreateObject("Scripting.Dictionary")
PosBeg = 1
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))
If PosEnd < 2 Then
Set Dict = Server.CreateObject("Scripting.Dictionary")
Exit Function
End If
boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
BoundaryPos = InStrB(1, RequestBin, boundary)
Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
Pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition"))
Pos = InStrB(Pos, RequestBin, getByteString("name="))
PosBeg = Pos + 6
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
Name = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename="))
PosBound = InStrB(PosEnd, RequestBin, boundary)
If PosFile <> 0 And (PosFile < PosBound) Then
FileCount = FileCount + 1
PosBeg = PosFile + 10
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
FileName = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "FileName", FileName
Pos = InStrB(PosEnd, RequestBin, getByteString("Content-Type:"))
PosBeg = Pos + 14
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))
ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "ContentType", ContentType
PosBeg = PosEnd + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
Else
FieldCount = FieldCount + 1
Pos = InStrB(Pos, RequestBin, getByteString(Chr(13)))
PosBeg = Pos + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
End If
UploadControl.Add "Value", Value
scrDict.Add Name, UploadControl
BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)
Loop
Set Dict = scrDict
Set scrDict = Nothing
End Function

'-------------------------------------------------------------------------
'saveAs - takes the uploaded file and saves it with your selected file name
and path
' Parameters
' sHTMLFormField [in] - name of the item to retreive data for
' sNewFile [in] - new file name and path to save the file under
' if sNewFile is empty store it to the current web path
' Returns True if file was saved correctly
'-------------------------------------------------------------------------
Function saveAs( sHTMLFormField, sNewFile)
If Dict.Exists(sHTMLFormField) And Len(getFileName(sHTMLFormField)) > 0
Then
binData = Dict.Item( sHTMLFormField).Item("Value")
binData = getString( binData)
Dim sFilePath
sFilePath = Path & getFileName(sHTMLFormField)
If Len( sNewFile) <> 0 Then sFilePath = sNewFile
Set oFSO = Server.CreateObject( "Scripting.FileSystemObject") '-
create the transfer file using Scripting.FileSystemObject ...
Set oTextStream = oFSO.CreateTextFile( sFilePath, True) '-create a file binary
write
oTextStream.Write( binData) '-write binData to the file
oTextStream.Close '-close the file
saveAs = True
Else
Response.Write( "File associated with HTML <FORM> field
name <INPUT NAME=" & sHTMLFormField & "> not
found!")
saveAs = False
End If
End Function

'-------------------------------------------------------------------------
'getData - Retrieves data from the Scripting.Dictionary object
' Parameters
' sHTMLFormField [in] - name of the item to retreive data for
'
' Returns data/value of a HTML Form Field from the Scripting.Dictionary object
'-------------------------------------------------------------------------
Function getData(sHTMLFormField)
If Dict.Exists(sHTMLFormField) Then
getData = Dict.Item( sHTMLFormField).Item("Value")
Else
getData = ""
End If
End Function

'-------------------------------------------------------------------------
'getFileName - Retrieves data from the Scripting.Dictionary object
' Parameters
' sHTMLFormField [in] - name of the item to retreive data for
'
' Returns data/value of a HTML Form Field from the Scripting.Dictionary object
'-------------------------------------------------------------------------
Function getFileName(sHTMLFormField)
Dim strHTMLFormField
If Dict.Exists(sHTMLFormField) Then
strHTMLFormField = Dict.Item( sHTMLFormField).Item("FileName")
Else
strHTMLFormField = ""
End If
Dim tPos
Dim strRtn
strRtn = ""
tPos = InStrRev(strHTMLFormField, "\")
If tPos = 0 Or IsNull(tPos) Then
strRtn = strHTMLFormField
Else
strRtn = Right(strHTMLFormField, Len(strHTMLFormField) - tPos)
End If
getFileName = strRtn
End Function

'-------------------------------------------------------------------------
'getContentType - Retrieves ContentType data from the uploaded file in the Scripting.Dictionary
object
' Parameters
' sHTMLFormField [in] - name of the item to retreive data for
'
' Returns data/value of a HTML Form Field from the Scripting.Dictionary object
'-------------------------------------------------------------------------
Function getContentType(sHTMLFormField)
If Dict.Exists(sHTMLFormField) Then
getContentType = Dict.Item( sHTMLFormField).Item("ContentType")
Else
getContentType = ""
End If
End Function

'*************************************************************************
'Private Functions
'*************************************************************************
'-------------------------------------------------------------------------
'getString - Parse out string from byte data
' Parameters
' StringBin [in] - Pull string out of byte data.
' Returns string from byte data.
'-------------------------------------------------------------------------
Function getString(StringBin)
Dim strRtn
strRtn = ""
For intCount = 1 To LenB(StringBin)
strRtn = strRtn & Chr(AscB(MidB(StringBin, intCount, 1)))
Next
getString = strRtn
End Function

'-------------------------------------------------------------------------
'getByteString - turn a string into byte data
' Parameters
' StringStr [in] - string to make into byte data.
' Returns byte data from a string.
'-------------------------------------------------------------------------
Function getByteString(StringStr)
Dim strRtn
strRtn = ""
For i = 1 To Len(StringStr)
Char = Mid(StringStr, i, 1)
strRtn = strRtn & ChrB(AscB(Char))
Next
getByteString = strRtn
End Function
]]>
</script>
</component>

Bookmark & Links

Link to Us